perm filename AAB[SCR,LCS] blob
sn#222538 filedate 1976-06-28 generic text, type T, neo UTF8
00100 101 N=INP(ML)
00200 IZ=ML
00300 ML=ML+1
00400 IF(N.EQ.IBLA)GO TO 101
00500 C ⊗⊗⊗⊗⊗ MAY 13,71 @@@@@@@@@@
00600 JA=-1
00700 IF(N.EQ.IPP)GO TO 1
00800 IF(N.EQ.IE)GO TO 2308
00900 IF(N.EQ.'R')CALL RUNIT
01000 C 'RUN' MAY REPLACE 'END' FOR LAST INST.
01100 IF(N.EQ.ID)GO TO 7720
01200 CALL ERR(LN)
01300 1 CALL SCANR
01400 LPAR=VX1
01500 IJ=LPAR
01600 IF(QX.GE.0)GO TO 5703
01700 IJ=LPAR+4
01800 C SETS UP PARAM FOR QUAD CALL
01900 V(I)=IJ+LK*10000
02000 V(I+1)=2*ALL
02100 C TEST "ALL" FEATURE HERE!!!!!!!
02200 C X=-13(DEGREES),=-14(X,Y),=-15(CIRCLE FUNCTS),=-16(LINE FUNCTS)
02300 V(I+2)=QX
02400 I=I+3
02500 QX=0.
02600 5703 IAMP=0
02700 IF(IJ.LE.NP(LK))GO TO 897
02800 IF(IJ.LT.31)NP(LK)=IJ
02900 897 IF(LPAR.EQ.32)LPAR=1
03000 V(I)=LPAR+LK*10000
03100 C +1=WDCNT, +2=CODE, +3='NM' CCCCC
03200 IJ=I+1
03300 I=I+4
03400 ITMP=0
03500 CODE=0
03600 NFLG=1
03700 ML=IZ+M
03800 C RE=REP R=RHY L=LIT M=MOVE MX=MOVX N=NOTES NU=NUM
03900 C S--L=SUBL S--N=SUBN T=TAP RT=RTAP RL=RLIST RN=RNOTES
04000 C QU=QUADC QUX=QUADX
04100 5702 ML=ML+1
04200 CC IF(ML.GT.72)GO TO 99
04300 N=INP(ML)
04400 IF(N.EQ.IBLA)GO TO 5702
04500 IF(N.EQ.',')GO TO 5702
04600 NL=INP(ML+1)
04700 JA=-1
04800 ISUB=0
04900 IF(N.EQ.IXX)GO TO 2703
05000 IF(N.EQ.'R')GO TO 6702
05100 IF(N.EQ.IF)GO TO 8702
05110 IF(N.EQ.IPP)GO TO 7006
05115 IF(N.NE.'C')GO TO 4005
05120 IF(NL.EQ.'U')GO TO 7006
05160 C FOR 'CUTOFF'
05200 4005 JA=0
05300 IF(N.EQ.IEN)GO TO 6005
05400 IF(N.EQ.'M')GO TO 703
05500 IF(N.EQ.'L')GO TO 2720
05600 IF(N.EQ.ISS)GO TO 6703
05700 IF(N.EQ.ITT)GO TO 4018
05800 IF(N.EQ.IQT)GO TO 5720
05900 IF(N.EQ.ISEMI)GO TO 2018
06000 C 7/75 IF(N.EQ.IPP)JA=-1
06100 C FOR ;P5 P3;
06200 7006 CALL SCANR
06300 IF(ISUB.EQ.8)GO TO 8
06400 I=I+JJ
06500 V(IJ+1)=NNUM+DF
06600 IF(JJ.EQ.1)GO TO 4006
06700 C IF NNUM IS '-2' THEN NOTES ARE PRINTED
06800 IF(NNUM.NE.-2)GO TO 5006
06900 IX=IJ+3
07000 DO 2006 K=2,JJ,3
07100 2006 CALL RANR(VX,K)
07200 C FOR RAN. SELEC. OF NOTES. FINDS HIGHEST NOTE.
07300 5006 IX=IJ+2
07400 DO 6006 K=1,JJ
07500 6006 V(IX+K)=VX(K)
07510 IF(NL.EQ.'U')GO TO 8006
07600 V(IX+JJ-2)=1.
07700 C ABOVE ENSURES THAT LAST RAND. UNIT REACHES 100% - 5/74 *********
07800 GO TO 3013
07900 4006 IF(JA)VX1=VX1/100.+9999.
08000 C CHANGES ;P5 P3; TO ;P5 9999.03; ***** CHECK OUT ON OTHER MACHINES!
08100 V(I-1)=VX1
08200 GO TO 3013
08210 8006 V(IJ+1)=-19
08220 C FOR 'CUTOFF N1, N2' -- TO END RAND TIMES TOGETHER.
08230 GO TO 3013
08300 6702 IF(NL.EQ.IE)GO TO 2703
08400 C JUMP IF "REP"
08500 IF(NL.EQ.ITT)GO TO 4018
08600 C JUMP IF "RTAP"
08700 CODE=-22
08800 IF(NL.EQ.'L')CODE=-46.0
08900 C JUMP IF "RLIST" (LIST OF RAND SELECTIONS)
09000 IF(NL.NE.IEN)GO TO 1016
09100 C JUMP IF NOT "RNOTES"
09200 JA=0
09300 C FOR SCANR
09400 CODE=-36.
09500 GO TO 1016
09600 6005 CODE=-33
09700 IF(NL.NE.'U')GO TO 1016
09800 CODE=-44.
09900 1610 JA=-1
10000 GO TO 1016
10100 8702 CODE=-35
10200 IF(NL.EQ.'U')GO TO 1016
10300 ML=ML+1
10400 CALL SCANR
10500 7 V(IJ+1)=CODE+DF
10600 V(IJ+2)=1.
10700 IF(VX1.GT.15)CALL ERR(4)
10800 C TRAPS F NUMS >15.
10900 V(I)=VX1+85.
11000 GO TO 7703
11100 C******** MOVE IS NEXT ***********
11200 703 BW=V(IJ-2)
11300 IC=0
11400 CC DO 7031 K=ML+1,72
11500 DO 7031 K=ML+1,LEND
11600 IF(INP(K).EQ.KSLA)GO TO 8031
11700 CC IF(INP(K).EQ.ISEMI)GO TO 8031
11800 7031 IF(INP(K).EQ.IXX)IC=-1
11900 C IC=-1 IS FOR MOVX
12000 8031 I=I-1
12100 V(I)=0
12200 X=-9900.-BY
12300 IF(BY.EQ.0)X=-9900.-BG(LK)
12400 IF(BW.EQ.X)GO TO 8005
12500 IF(BW.NE.-9900.-BY)GO TO 1102
12600 V(IJ-2)=X
12700 GO TO 8005
12800 1102 V(IJ)=V(IJ-1)
12900 V(IJ-1)=X
13000 IJ=IJ+1
13100 I=I+1
13200 8005 LP=IJ-1
13300 BW=-9900.-X
13400 ISUB=2
13500 IZ=-1
13600 C ABOVE ARRANGES NECESSARY BG TIME HEADINGS.
13700 4703 GO TO 1299
13800 102 IF(IZ.LT.0)GO TO 2102
13900 C SKIPS NEXT FIRST TIME
14000 BW=V(ICT)+BW
14100 V(I)=-9900.-BW
14200 V(I+1)=V(LP)
14300 V(I+2)=(JJ+2)*ALL
14400 V(I+3)=CODE+DF
14500 I=I+4
14600 IZ=1
14700 2102 IF(BW.LT.10000.)CALL BGSORT(BW)
14800 C ROUND-OFF NONSENSE
14900 2 VX3=-9900.
15000 VX2=VX3
15100 CALL SCANR
15200 IF(JJ.GT.0)GO TO 5102
15300 JJ=ILIT
15400 C SLASH WILL REPEAT MOVE INPUT -- 6/74
15500 DO 6102 K=1,JJ
15600 6102 VX(K)=VX(K+20)
15700 GO TO 5005
15800 C::::::::::::::: PUT THIS, AND AT 5505, IN SCOR5 ALSO ::::::::::::::
15900 5102 IF(JJ.EQ.4)CALL ERR(LN)
16000 C ERROR -- 4 ITEMS IN MOVE IMPOSSIBLE
16100 IF(VX3.NE.-9900.)GO TO 3102
16200 IF(VX2.NE.-9900.)GO TO 4102
16300 VX2=VX1
16400 VX1=10000.
16500 4102 VX3=VX2
16600 JJ=3
16700 C 1,2 OR 3 NUMS CAN BE USED IN NON-RAN MOVES.
16800 3102 IF(IZ.GE.0)GO TO 3006
16900 V(IJ)=(JJ+2)*ALL
17000 C WORD COUNT
17100 CODE=-55.
17200 IF(JJ.NE.3)CODE=-57.
17300 IF(NFLG)CODE=CODE-1.
17400 IF(IC)CODE=-59.
17500 C CODE=-56 OR -58 FOR NOTES.
17600 V(IJ+1)=CODE+DF
17700 IZ=0
17800 3006 IF(NFLG.EQ.1)GO TO 5005
17900 CALL RANR(VX,2)
18000 IF(JJ.NE.3)CALL RANR(VX,4)
18100 C FOR RAN. SELEC. OF NOTES. FINDS HIGHEST NOTE.
18200 5005 ICT=I
18300 ILIT=JJ
18400 C SAVES FOR SLASH REPEAT FEATURE
18500 IJ=IJ+1
18600 DO 1006 K=1,JJ
18700 VX(20+K)=VX(K)
18800 C SAVES FOR SLASH REPEAT FEATURE
18900 1006 V(IJ+K)=VX(K)
19000 I=I+JJ
19100 IJ=I+2
19200 IF(IAMP.EQ.0)GO TO 1299
19300 C*************** MAY 18,71 ***** ALWAYS RESETS TO TIME 0 WHEN MOVE IS USED.
19400 V(I)=-9900.-BY
19500 GO TO 8703
19600
19700 7703 V(IJ)=4.*ALL
19800 8703 I=I+1
19900 GO TO 4773
20000 C FOR SUBROUTINES, -12=NUMS. -11=LETTERS.
20100 6703 CODE=-12.
20200 IF(INP(ML+3).EQ.'L')CODE=-11.
20300 V(IJ)=2.*ALL
20400 V(IJ+1)=CODE+DF
20500 I=I-1
20600 GO TO 4773
20700 4018 CNT(LK)=-9900.-BY
20800 P(LK)=V(I-4)
20900 CC 6/74 COLGATE JREAD=3
21000 CC 6/74 COLGATE GO TO 4400
21100 1444 IF(READER(JNP))CALL RUNIT
21200 C READS A LINE. IF END OF FILE, JUMPS.
21300 443 IF(LN.NE.0)REREAD 107,K,IPT(LK,1)
21400 IF(LN.EQ.0)REREAD 8001,IPT(LK,1)
21500 C NAME OF RHYTHM FILE. (ONLY ONE PER INST.) READS DATA JUST BEFORE RUN
21600 IF(J.EQ.'CONDU')GO TO 444
21700 IF(NL.NE.ITT)GO TO 2338
21800 CODE=-23.
21900 GO TO 1016
22000 2338 I=I-4
22100 GO TO 4773
22200 3018 CNT(KZY)=-9900.
22300 GO TO 1444
22400 444 P(KZY)=980000.
22500 GO TO 2308
22600 C CAN'T USE 'TAP' OR 'RTAP' WITH INST KZY IF USING 'CONDUCT'.
22700 C 'REP'
22800 2703 ML=ML+1
22900 VX1=0
23000 VX2=0
23100 VX3=0
23200 IF(N.EQ.IXX)GO TO 2704
23300 INP(ML)=IBLA
23400 INP(ML+1)=IBLA
23500 C WIPES OUT 'EP' IN 'REP'
23600 2704 CALL SCANR
23700 V(IJ)=3.
23800 V(IJ+1)=-66.0
23900 IF(VX1.EQ.32.)VX1=1.
24000 IF(VX1.EQ.0)VX1=LPAR
24100 IF(VX2.EQ.0)VX2=LK-1
24200 V(IJ+2)=VX1+VX2*10000.
24300 KL=VX2
24400 IF(DUR(LK).LT.0)DUR(LK)=DUR(KL)
24500 IF(VX3.EQ.0)GO TO 4773
24600 L=VX3
24700 ML=LK+1
24800 DO 1018 KL=ML,L
24900 IF(LPAR.LE.NP(KL))GO TO 997
25000 IF(LPAR.LT.31)NP(KL)=LPAR
25100 997 IF(DUR(KL))DUR(KL)=DUR(LK)
25200 C TO SET DUR WHEN DUPLICATING NOTES THAT END WITH 'END;;'
25300 V(I)=V(I-4)+10000.
25400 V(I+1)=3.
25500 V(I+2)=-66.
25600 V(I+3)=V(I-1)
25700 1018 I=I+4
25800 GO TO 4773
25900
26000 2018 IF(DF.EQ.0)GO TO 20181
26100 C NEXT FOR Pn SUBR/ I.E. NOTHING BUT P AND SUB CALL. 7/73
26200 V(IJ+1)=-201.
26300 V(IJ+2)=1.
26400 V(IJ+3)=0
26500 GO TO 7703
26600 20181 V(IJ)=3.
26700 V(IJ+1)=-66.
26800 V(IJ+2)=NW+LK*10000
26900 GO TO 4773
27000 C READS /P5 .3 "ABC" .7 "XYZ"/
27100
27200 8 V(IJ+1)=-77.+DF
27300 C DF HAS SUBR CALL INFO
27400 I=I+1
27500 VX(JJ-1)=1
27600 C FOR RAND. SINGLE LITS.
27700 DO 3722 K=1,JJ,2
27800 V(I)=VX(K)
27900 3722 I=I+1
28000 V(IJ+2)=JJ/2
28100 V(IJ+3)=I
28200 DO 4722 K=2,JJ,2
28300 KN=I
28400 I=I+1
28500 L=VX(K)
28600 DO 6722 KL=L,LEND
28700 IF(INP(KL).EQ.IQT)GO TO 4722
28800 IV(I)=INP(KL)
28900 6722 I=I+1
29000 4722 V(KN)=I-KN-1
29100 V(IJ)=(I-IJ)*ALL
29200 GO TO 4773
29300 2720 QTS=0
29400 ISUB=104
29500 GO TO 1299
29600
29610 104 KL=0
29700 DO 6721 K=ML,LEND
29752 L=INP(K)
29804 IF(L.EQ.IBLA)GO TO 6721
29856 JC=K+1
29908 IF(L.EQ.IQT)GO TO 7721
29960 IF(L.EQ.KSLA)GO TO 7232
30012 IF(L.EQ.ISEMI)GO TO 7232
30064 IF(L.EQ.'%')INP(K)=KSLA
30116 IF(L.EQ.'!')INP(K)=ISEMI
30168 IF(KL.EQ.0)KL=K
30220 6721 CONTINUE
30272 C FOR REPEAT OF ITEM BY SLASH
30324 C KL IS START OF QUOTE, THEN K IS END -- WHEN NO "S ARE USED.
30376 7232 IF(KL.EQ.0)GO TO 7233
30428 JC=KL
30480 ML=K+1
30532 JD=K-1
30584 NLIT=K-KL
30636 GO TO 8721
30688
30740 7233 DO 7230 KL=ILIT,ILIT+NLIT
30800 V(I)=V(KL)
30900 7230 I=I+1
31000 GO TO 27222
31100 7231 CONTINUE
31200
31300 5720 IAMP=-1
31400 JC=ML+1
31500 C FOR SINGLE 'LIT' ITEMS.
31600 7721 DO 1722 KL=JC+1,LEND
31700 IF(INP(KL).NE.IQT)GO TO 1722
31800 JD=KL-1
31900 ML=KL+1
32000 NLIT=KL-JC
32100 C EXTENT OF LIT ITEM IS FOUND
32200 GO TO 8721
32300 1722 CONTINUE
32400 C CAN'T USE SLASH FOR REPEAT AFTER @Q
32500 8721 V(I)=NLIT
32600 ILIT=I
32700 DO 9721 K=JC,JD
32800 C PUTS ITEM IN "IV" ARRAY
32900 I=I+1
33000 9721 IV(I)=INP(K)
33100 I=I+1
33200 27222 IF(IAMP.EQ.0)GO TO 1299
33300 2722 V(I)=999.
33400 QTS=-1.
33500 27221 V(IJ+1)=-88.+DF
33600 V(IJ)=(I-IJ+1)*ALL
33700 IJ=IJ+2
33800 V(IJ)=IJ+1
33900 I=I+1
34000 ISUB=1
34100 GO TO 1299
34200
34300 7720 V(I)=LK
34400 V(I+1)=3.
34500 V(I+2)=-67.
34600 ML=ML+4
34700 CALL SCANR
34800 V(I+3)=VX1
34900 I=I+4
35000 L=VX1
35100 IF(NP(LK).LT.NP(L))NP(LK)=NP(L)
35200 IF(DUR(LK).LT.0)DUR(LK)=DUR(L)
35300 GO TO 4773
35400 C TYPE 'DUPL N;' N=INST # TO BE DUPLICATED.
35500 142 FORMAT(I,15A5)
35600 1301 FORMAT(15A5)
35700 CCC2773 FORMAT(I,A5,72A1)
35800 CC2114 FORMAT(I,80A1)
35900 300 FORMAT(I,3F,A1)
36000 301 FORMAT(3F,A1)
36100 6 KB=KB+1
36200 IF(JED.GT.0)JED=0
36300 IF(J.EQ.'INSER')GO TO 1340
36400 OTH(KB,1)=VX1*100000.+VX2*100.+VX3
36500 GO TO 340
36600 1340 X=VX1
36700 IF(VX2.NE.0)X=1000000.+VX1*100000.+VX2
36800 OTH(KB,1)=X
36900 GO TO 1338
37000 C ABOVE IS TO PUT INSERT AFTER NOTE # OF A PARTICULAR
37100 C INSTRUMENT. FOR COMMENT AT START, SET BG TIME TO 1,1
37200 C - BEGIN LINE WITH <,END WITH ;
37300 C UP TO 75 CHARACTERS MAY BE TYPED.
37400 340 IF(VX3.NE.2)GO TO 1338
37500 IF(ITYP.GE.0)GO TO 449
37600 CC JREAD=5
37700 CC 6/74 COLGATE GO TO 4400
37800 IF(READER(JNP))CALL RUNIT
37900 C READS A LINE. IF END OF FILE, JUMPS.
38000 445 OTH(KB,3)=1.
38100 IF(LN.EQ.0)GO TO 447
38200 REREAD 300,K,OTH(KB,2)
38300 GO TO 1447
38400 447 REREAD 301,OTH(KB,2)
38500 1447 IF(JED)GO TO 2308
38600 3445 TYPE TEDIT
38700 ACCEPT 77732,K
38800 IF(K.EQ.IG)JED=-1
38900 IF(J.EQ.'INSER')GO TO 3446
39000 IF(K.NE.'Y')GO TO 2308
39100 IF(JED)GO TO 2308
39200 449 TYPE TPALN
39300 ACCEPT 301,OTH(KB,2)
39400 IF(JED)WRITE(21,301) OTH(KB,2)
39500 GO TO 2308
39600
39700 1338 IF(ITYP.GE.0)GO TO 1449
39800 CC JREAD=6
39900 CC 6/74 COLGATE GO TO 4400
40000 IF(READER(JNP))CALL RUNIT
40100 C READS A LINE. IF END OF FILE, JUMPS.
40200 446 IF(LN.EQ.0)GO TO 448
40300 REREAD 142,K,(OTH(KB,JD),JD=2,16)
40400 GO TO 1446
40500 448 REREAD 1301,(OTH(KB,JD),JD=2,16)
40600 1446 IF(JED)2446,3445,2446
40700 3446 IF(K.NE.'Y')GO TO 2446
40800 IF(JED)GO TO 2446
40900 1449 TYPE TPALN
41000 ACCEPT 1301,(OTH(KB,JD),JD=2,16)
41100 IF(JED)WRITE(21,1301)(OTH(KB,JD),JD=2,16)
41200 2446 X=OTH(KB,2)
41300 IF(J.NE.'INSER')GO TO 971
41400 IF(VX3.EQ.0)GO TO 971
41500 IF(X.NE.'*')GO TO 6
41600 971 IF(X.EQ.'*')KB=KB-1
41700 C ALLOWS SEVERAL LINES OF 'INSERT' IF ANY 3RD #.
41800 C LAST LINE HAS '*' IN COLUMN 1.
41900 GO TO 2308
42000 C IF NO PARAM NUM IS GIVEN, ALL PARAMS MUST BE TYPED.
42100 C INSERT MAY INCLUDE 10 CHARS(P3-P30),
42200 C P2, A # ONLY. IF MORE THAN 1 PARAM IS TO BE EDITED AND
42300 C P2 IS ONE OF THEM, FIRST EDIT P2 TO DESIRED VALUE,
42400 C CHANGE P2 TO MINUS = THEN INSERT ENTIRE NOTE TO PLAY
42500 C JUST AFTER ORIGINAL NOTE(WHICH WILL BE A REST).
42600 C BX=INST N. Y=NOTE N. Z=PARAM N.